home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
amiga
/
Utility.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
24KB
|
776 lines
(*************************************************************************
$RCSfile: Utility.mod $
Description: Interface to utility.library
Created by: fjc (Frank Copeland)
$Revision: 3.9 $
$Author: fjc $
$Date: 1995/06/04 23:13:14 $
Includes Release 40.15
(C) Copyright 1985-1993 Commodore-Amiga, Inc.
All Rights Reserved
Oberon-A interface Copyright © 1994-1995, Frank Copeland.
This file is part of the Oberon-A Interface.
See Oberon-A.doc for conditions of use and distribution.
*************************************************************************)
<* STANDARD- *>
MODULE [2] Utility;
IMPORT SYS := SYSTEM, Kernel, e := Exec, s := Sets;
(*-- Pointer declarations ---------------------------------------------*)
TYPE
ClockDataPtr * = POINTER TO ClockData;
HookPtr * = POINTER TO Hook;
TagItemPtr * = POINTER TO TagItem;
NamedObjectPtr * = POINTER TO NamedObject;
(*-- Library definitions ----------------------------------------------*)
(*
** $VER: date.h 39.1 (20.1.92)
**
** Date conversion routines ClockData definition.
*)
TYPE
ClockData* = RECORD
sec * : e.UWORD;
min * : e.UWORD;
hour * : e.UWORD;
mday * : e.UWORD;
month* : e.UWORD;
year * : e.UWORD;
wday * : e.UWORD;
END; (* ClockData *)
(*
** $VER: hooks.h 39.2 (16.6.93)
**
** callback hooks
*)
TYPE
(* new standard hook structure *)
HookFunc * =
PROCEDURE (hook : HookPtr; object : e.APTR; message : e.APTR) : e.APTR;
AsmHookFunc * = PROCEDURE () : e.APTR;
(*
*** Oberon-A Note ***
Oberon-A does not allow register parameters for normal procedures,
so if you use an AsmHookFunc, you must use SYS.GETREG to access
the parameters. e.g:
PROCEDURE MyHookFunc () : e.APTR
VAR hook : HookPtr; object : e.APTR; message : e.APTR;
BEGIN
SYS.GETREG (8, hook);
SYS.GETREG (10, object);
SYS.GETREG (9, message);
...
END MyHookFunc;
See the procedure InitHook() for a simpler alternative.
*)
HookBase *= RECORD (e.MinNodeBase) END;
HookBasePtr *= POINTER TO HookBase;
Hook* = RECORD (HookBase)
minNode * : e.MinNode;
entry * : AsmHookFunc; (* assembler entry point *)
subEntry* : HookFunc; (* often HLL entry point *)
data * : e.APTR; (* owner specific *)
END; (* Hook *)
(*
* Hook calling conventions:
* A0 - pointer to hook data structure itself
* A1 - pointer to parameter structure ("message") typically
* beginning with a longword command code, which makes
* sense in the context in which the hook is being used.
* A2 - Hook specific address data ("object," e.g, GadgetInfo)
*
* Control will be passed to the routine hEntry. For many
* High-Level Languages (HLL), this will be an assembly language
* stub which pushes registers on the stack, does other setup,
* and then calls the function at hSubEntry.
*
* The C standard receiving code is:
* CDispatcher( hook, object, message )
* STRUCT Hook *hook;
* APTR object;
* APTR message;
*
* NOTE that register natural order differs from this convention
* for C parameter order, which is A0,A2,A1.
*
* The assembly language stub for "vanilla" C parameter conventions
* could be:
_hookEntry:
move.l a1,-(sp) ; push message packet pointer
move.l a2,-(sp) ; push object pointer
move.l a0,-(sp) ; push hook pointer
move.l h_SubEntry(a0),a0 ; fetch C entry point ...
jsr (a0) ; ... and call it
lea 12(sp),sp ; fix stack
rts
* with this function as your interface stub, you can write
* a Hook setup function as:
SetupHook( hook, c_function, userdata )
STRUCT Hook *hook;
ULONG ( *c_function)();
VOID *userdata;
{
ULONG ( *hookEntry)();
hook->h_Entry = hookEntry;
hook->h_SubEntry = c_function;
hook->h_Data = userdata;
}
* with Lattice C pragmas, you can put the C function in the
* h_Entry field directly if you declare the function:
ULONG __saveds __asm
CDispatcher( register __a0 STRUCT Hook *hook,
register __a2 VOID *object,
register __a1 ULONG *message );
*
****)
(*
** $VER: tagitem.h 40.1 (19.7.93)
**
** extended specification mechanism
*)
(*****************************************************************************)
(* Tags are a general mechanism of extensible data arrays for parameter
* specification and property inquiry. In practice, tags are used in arrays,
* or chain of arrays.
*
*)
TYPE
Tag * = SYS.LONGWORD;
TagID * = e.ULONG;
TagItem* = RECORD
tag* : TagID;
data* : Tag;
END; (* TagItem *)
TagListPtr * = POINTER TO ARRAY MAX (INTEGER) OF TagItem;
(* Types for 'ARRAY OF TagItem' Parameters: *)
Tags1 * = ARRAY 1 OF TagItem;
Tags2 * = ARRAY 2 OF TagItem;
Tags3 * = ARRAY 3 OF TagItem;
Tags4 * = ARRAY 4 OF TagItem;
Tags5 * = ARRAY 5 OF TagItem;
Tags6 * = ARRAY 6 OF TagItem;
Tags7 * = ARRAY 7 OF TagItem;
Tags8 * = ARRAY 8 OF TagItem;
Tags9 * = ARRAY 9 OF TagItem;
Tags10 * = ARRAY 10 OF TagItem;
Tags11 * = ARRAY 11 OF TagItem;
Tags12 * = ARRAY 12 OF TagItem;
Tags13 * = ARRAY 13 OF TagItem;
Tags14 * = ARRAY 14 OF TagItem;
Tags15 * = ARRAY 15 OF TagItem;
Tags16 * = ARRAY 16 OF TagItem;
Tags17 * = ARRAY 17 OF TagItem;
Tags18 * = ARRAY 18 OF TagItem;
Tags19 * = ARRAY 19 OF TagItem;
Tags20 * = ARRAY 20 OF TagItem;
Tags21 * = ARRAY 21 OF TagItem;
Tags22 * = ARRAY 22 OF TagItem;
Tags23 * = ARRAY 23 OF TagItem;
Tags24 * = ARRAY 24 OF TagItem;
Tags25 * = ARRAY 25 OF TagItem;
Tags26 * = ARRAY 26 OF TagItem;
Tags27 * = ARRAY 27 OF TagItem;
Tags28 * = ARRAY 28 OF TagItem;
Tags29 * = ARRAY 29 OF TagItem;
CONST
(* constants for Tag.tag, control tag values *)
done * = 0; (* terminates array of TagItems. tiData unused *)
end * = done;
ignore* = 1; (* ignore this item, not end of array *)
more * = 2; (* tiData is pointer to another array of TagItems
* note that this tag terminates the current array
*)
skip * = 3; (* skip this and the next tiData items *)
(* differentiates user tags from control tags *)
user * = 80000000H;
(* If the tagUser bit is set in a tag number, it tells utility.library that
* the tag is not a control tag (like tagDone, tagIgnore, tagMore) and is
* instead an application tag. "USER" means a client of utility.library in
* general, including system code like Intuition or ASL, it has nothing to do
* with user code.
*)
(*****************************************************************************)
(* Tag filter logic specifiers for use with FilterTagItems() *)
filterAnd * = 0; (* exclude everything but filter hits *)
filterNot * = 1; (* exclude only filter hits *)
(*****************************************************************************)
(* Mapping types for use with MapTags() *)
removeNotFound * = 0; (* remove tags that aren't in mapList *)
keepNotFound * = 1; (* keep tags that aren't in mapList *)
(*****************************************************************************)
(*
** $VER: name.h 39.5 (11.8.93)
**
** Namespace definitions
**)
(*****************************************************************************)
TYPE
(* The named object structure *)
NamedObject * = RECORD
object * : e.APTR; (* Your pointer, for whatever you want *)
END;
CONST
(* Tags for AllocNamedObject() *)
nameSpace * = 4000; (* Tag to define namespace *)
userSpace * = 4001; (* tag to define userspace *)
priority * = 4002; (* tag to define priority *)
flags * = 4003; (* tag to define flags *)
(* Flags for tag anoFlags *)
nodups * = 0; (* Default allow duplicates *)
case * = 1; (* Default to caseless... *)
(*****************************************************************************)
(*
** $VER: pack.h 39.3 (10.2.93)
**
** Control attributes for Pack/UnpackStructureTags()
*)
(*****************************************************************************)
(* PackTable definition:
*
* The PackTable is a simple array of LONGWORDS that are evaluated by
* PackStructureTags() and UnpackStructureTags().
*
* The table contains compressed information such as the tag offset from
* the base tag. The tag offset has a limited range so the base tag is
* defined in the first longword.
*
* After the first longword, the fields look as follows:
*
* +--------- 1 = signed, 0 = unsigned (for bits, 1=inverted boolean)
* |
* | +------ 00 = Pack/Unpack, 10 = Pack, 01 = Unpack, 11 = special
* | / \
* | | | +-- 00 = Byte, 01 = Word, 10 = Long, 11 = Bit
* | | | / \
* | | | | | /----- For bit operations: 1 = TAG_EXISTS is TRUE
* | | | | | |
* | | | | | | /-------------------- Tag offset from base tag value
* | | | | | | | \
* m n n o o p q q q q q q q q q q r r r s s s s s s s s s s s s s
* \ | | |
* Bit offset (for bit operations) ----/ | |
* \ |
* Offset into data structure -----------------------------------/
*
* A -1 longword signifies that the next longword will be a new base tag
*
* A 0 longword signifies that it is the end of the pack table.
*
* What this implies is that there are only 13-bits of address offset
* and 10 bits for tag offsets from the base tag. For most uses this
* should be enough, but when this is not, either multiple pack tables
* or a pack table with extra base tags would be able to do the trick.
* The goal here was to make the tables small and yet flexible enough to
* handle most cases.
*)
CONST
signed * = 31;
unpack * = 30; (* Note that these are active low... *)
pack * = 29; (* Note that these are active low... *)
exists * = 26; (* Tag exists bit true flag hack... *)
(*****************************************************************************)
CONST
ctrlPackUnpack * = 000000000H;
ctrlPackOnly * = 040000000H;
ctrlUnpackOnly * = 020000000H;
ctrlByte * = 080000000H;
ctrlWord * = 088000000H;
ctrlLong * = 090000000H;
ctrlUByte * = 000000000H;
ctrlUWord * = 008000000H;
ctrlULong * = 010000000H;
ctrlBit * = 018000000H;
ctrlFlipBit * = 098000000H;
(*
The following C macros are included for information only. They may be
implemented as procedures in the future if there is any demand for it.
(*****************************************************************************)
(* Macros used by the next batch of macros below. Normally, you don't use
* this batch directly. Then again, some folks are wierd
*)
#define PK_BITNUM1(flg) ((flg) == 0x01 ? 0 : (flg) == 0x02 ? 1 : (flg) == 0x04 ? 2 : (flg) == 0x08 ? 3 : (flg) == 0x10 ? 4 : (flg) == 0x20 ? 5 : (flg) == 0x40 ? 6 : 7)
#define PK_BITNUM2(flg) ((flg < 0x100 ? PK_BITNUM1(flg) : 8+PK_BITNUM1(flg >> 8)))
#define PK_BITNUM(flg) ((flg < 0x10000 ? PK_BITNUM2(flg) : 16+PK_BITNUM2(flg >> 16)))
#define PK_WORDOFFSET(flg) ((flg) < 0x100 ? 1 : 0)
#define PK_LONGOFFSET(flg) ((flg) < 0x100 ? 3 : (flg) < 0x10000 ? 2 : (flg) < 0x1000000 ? 1 : 0)
#define PK_CALCOFFSET(type,field) ((ULONG)(&((struct type * )0)->field))
(*****************************************************************************)
(* Some handy dandy macros to easily create pack tables
*
* Use PACK_STARTTABLE() at the start of a pack table. You pass it the
* base tag value that will be handled in the following chunk of the pack
* table.
*
* PACK_ENDTABLE() is used to mark the end of a pack table.
*
* PACK_NEWOFFSET() lets you change the base tag value used for subsequent
* entries in the table
*
* PACK_ENTRY() lets you define an entry in the pack table. You pass it the
* base tag value, the tag of interest, the type of the structure to use,
* the field name in the structure to affect and control bits (combinations of
* the various PKCTRL_XXX bits)
*
* PACK_BYTEBIT() lets you define a bit-control entry in the pack table. You
* pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
* affects. This macro should be used when the field being affected is byte
* sized.
*
* PACK_WORDBIT() lets you define a bit-control entry in the pack table. You
* pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
* affects. This macro should be used when the field being affected is word
* sized.
*
* PACK_LONGBIT() lets you define a bit-control entry in the pack table. You
* pass it the same data as PACK_ENTRY, plus the flag bit pattern this tag
* affects. This macro should be used when the field being affected is longword
* sized.
*
* EXAMPLE:
*
* ULONG packTable[] =
* {
* PACK_STARTTABLE(GA_Dummy),
* PACK_ENTRY(GA_Dummy,GA_Left,Gadget,LeftEdge,PKCTRL_WORD|PKCTRL_PACKUNPACK),
* PACK_ENTRY(GA_Dummy,GA_Top,Gadget,TopEdge,PKCTRL_WORD|PKCTRL_PACKUNPACK),
* PACK_ENTRY(GA_Dummy,GA_Width,Gadget,Width,PKCTRL_UWORD|PKCTRL_PACKUNPACK),
* PACK_ENTRY(GA_Dummy,GA_Height,Gadget,Height,PKCTRL_UWORD|PKCTRL_PACKUNPACK),
* PACK_WORDBIT(GA_Dummy,GA_RelVerify,Gadget,Activation,PKCTRL_BIT|PKCTRL_PACKUNPACK,GACT_RELVERIFY)
* PACK_ENDTABLE
* };
*)
#define PACK_STARTTABLE(tagbase) (tagbase)
#define PACK_NEWOFFSET(tagbase) (-1L),(tagbase)
#define PACK_ENDTABLE 0
#define PACK_ENTRY(tagbase,tag,type,field,control) (control | ((tag-tagbase) << 16L) | PK_CALCOFFSET(type,field))
#define PACK_BYTEBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | PK_CALCOFFSET(type,field) | (PK_BITNUM(flags) << 13L))
#define PACK_WORDBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | (PK_CALCOFFSET(type,field)+PK_WORDOFFSET(flags)) | ((PK_BITNUM(flags)&7) << 13L))
#define PACK_LONGBIT(tagbase,tag,type,field,control,flags) (control | ((tag-tagbase) << 16L) | (PK_CALCOFFSET(type,field)+PK_LONGOFFSET(flags)) | ((PK_BITNUM(flags)&7) << 13L))
*)
(*****************************************************************************)
(*
** $VER: utility.h 39.2 (18.9.92)
*)
CONST
utilityName * = "utility.library";
TYPE
UtilityBasePtr* = POINTER TO UtilityBase;
UtilityBase * = RECORD (e.LibraryBase)
libNode * : e.Library;
language * : SHORTINT;
reserved * : SHORTINT;
END;
(*-- Library Base variable --------------------------------------------*)
VAR
base* : UtilityBasePtr;
(*-- Library Functions ------------------------------------------------*)
(*
** $VER: utility_protos.h 39.12 (10.2.93)
*)
(*--- functions in V36 or higher (Release 2.0) ---*)
(* *** TagItem FUNCTIONS *** *)
PROCEDURE FindTagItemA* [base,-30]
( tagVal [0] : TagID;
tagList [8] : ARRAY OF TagItem )
: TagItemPtr;
PROCEDURE FindTagItem* [base,-30]
( tagVal [0] : TagID;
tagList [8] : TagListPtr )
: TagItemPtr;
PROCEDURE GetTagDataPA* [base,-36]
( tagVal [0] : TagID;
defaultVal [1] : e.APTR;
tagList [8] : ARRAY OF TagItem )
: e.APTR;
PROCEDURE GetTagDataA* [base,-36]
( tagVal [0] : TagID;
defaultVal [1] : e.ULONG;
tagList [8] : ARRAY OF TagItem )
: e.ULONG;
PROCEDURE GetTagDataP* [base,-36]
( tagVal [0] : TagID;
defaultVal [1] : e.APTR;
tagList [8] : TagListPtr )
: e.APTR;
PROCEDURE GetTagData* [base,-36]
( tagVal [0] : TagID;
defaultVal [1] : e.ULONG;
tagList [8] : TagListPtr )
: e.ULONG;
PROCEDURE PackBoolTagsA* [base,-42]
( initialFlags [0] : s.SET32;
tagList [8] : ARRAY OF TagItem;
boolMap [9] : ARRAY OF TagItem )
: s.SET32;
PROCEDURE PackBoolTags* [base,-42]
( initialFlags [0] : s.SET32;
tagList [8] : TagListPtr;
boolMap [9] : ARRAY OF TagItem )
: s.SET32;
PROCEDURE NextTagItem* [base,-48]
( VAR tagListPtr [8] : TagItemPtr )
: TagItemPtr;
PROCEDURE FilterTagChanges* [base,-54]
( newTagList [8] : ARRAY OF TagItem;
oldTagList [9] : ARRAY OF TagItem;
apply [0] : BOOLEAN );
PROCEDURE MapTags* [base,-60]
( tagList [8] : ARRAY OF TagItem;
mapList [9] : ARRAY OF TagItem;
includeMiss [0] : LONGINT );
PROCEDURE AllocateTagItems* [base,-66]
( numItems [0] : e.ULONG )
: TagListPtr;
PROCEDURE CloneTagItemsA* [base,-72]
( tagList [8] : ARRAY OF TagItem )
: TagListPtr;
PROCEDURE CloneTagItems* [base,-72]
( tagList [8] : TagListPtr )
: TagListPtr;
PROCEDURE FreeTagItems* [base,-78]
( tagList [8] : TagListPtr );
PROCEDURE RefreshTagItemClones* [base,-84]
( cloneList [8] : ARRAY OF TagItem;
origList [9] : ARRAY OF TagItem );
PROCEDURE TagInArray* [base,-90]
( tagVal [0] : TagID;
tagArray [8] : ARRAY OF TagID )
: BOOLEAN;
PROCEDURE FilterTagItems* [base,-96]
( tagList [8] : ARRAY OF TagItem;
filterArray [9] : ARRAY OF TagID;
logic [0] : LONGINT )
: LONGINT;
(* *** HOOK FUNCTIONS *** * *)
PROCEDURE CallHookPkt* [base,-102]
( hook [8] : HookBasePtr;
object [10] : e.ADDRESS;
paramPacket [9] : e.ADDRESS )
: e.ULONG;
(* *** DATE FUNCTIONS *** * *)
PROCEDURE Amiga2Date* [base,-120]
( amigaTime [0] : e.ULONG;
VAR date [8] : ClockData );
PROCEDURE Date2Amiga* [base,-126]
( VAR date [8] : ClockData )
: e.ULONG;
PROCEDURE CheckDate* [base,-132]
( VAR date [8] : ClockData )
: e.ULONG;
(* *** 32 BIT MATH FUNCTIONS *** * *)
PROCEDURE SMult32* [base,-138]
( factor1 [0] : LONGINT;
factor2 [1] : LONGINT )
: LONGINT;
PROCEDURE UMult32* [base,-144]
( factor1 [0] : e.ULONG;
factor2 [1] : e.ULONG )
: e.ULONG;
(* NOTE: Quotient:Remainder returned in d0:d1 *)
PROCEDURE SDivMod32* [base,-150]
( dividend [0] : LONGINT;
divisor [1] : LONGINT )
: LONGINT;
PROCEDURE UDivMod32* [base,-156]
( dividend [0] : e.ULONG;
divisor [1] : e.ULONG )
: e.ULONG;
(*--- functions in V37 or higher (Release 2.04) ---*)
(* *** International string routines *** *)
PROCEDURE Stricmp* [base,-162]
( string1 [8] : ARRAY OF CHAR;
string2 [9] : ARRAY OF CHAR )
: LONGINT;
PROCEDURE Strnicmp* [base,-168]
( string1 [8] : ARRAY OF CHAR;
string2 [9] : ARRAY OF CHAR;
length [0] : LONGINT )
: LONGINT;
PROCEDURE ToUpper* [base,-174]
( character [0] : CHAR )
: CHAR;
PROCEDURE ToLower* [base,-180]
( character [0] : CHAR )
: CHAR;
(*--- functions in V39 or higher (Release 3) ---*)
(* More tag Item functions *)
PROCEDURE ApplyTagChanges* [base,-186]
( list [8] : ARRAY OF TagItem; changeList [9] : ARRAY OF TagItem );
(* 64 bit integer muliply functions. The results are 64 bit quantities *)
(* returned in D0 and D1 *)
PROCEDURE SMult64* [base,-198]
( arg1 [0] : LONGINT; arg2 [1] : LONGINT )
: LONGINT;
PROCEDURE UMult64* [base,-204]
( arg1 [0] : e.ULONG; arg2 [1] : e.ULONG )
: e.ULONG;
(* Structure to Tag and Tag to Structure support routines *)
PROCEDURE PackStructureTagsA* [base,-210]
( pack [8] : e.APTR; packTable [9] : ARRAY OF e.ULONG;
tagList [10] : ARRAY OF TagItem )
: e.ULONG;
PROCEDURE PackStructureTags* [base,-210]
( pack [8] : e.APTR; packTable [9] : ARRAY OF e.ULONG;
tagList [10] : TagListPtr )
: e.ULONG;
PROCEDURE UnpackStructureTagsA* [base,-216]
( pack [8] : Tag; packTable [9] : ARRAY OF e.ULONG;
tagList [10] : ARRAY OF TagItem )
: e.ULONG;
PROCEDURE UnpackStructureTags* [base,-216]
( pack [8] : e.APTR; packTable [9] : ARRAY OF e.ULONG;
tagList [10] : TagListPtr )
: e.ULONG;
(* New, object-oriented NameSpaces *)
PROCEDURE AddNamedObject* [base,-222]
( nameSpace [8] : NamedObjectPtr; object [9] : NamedObjectPtr )
: BOOLEAN;
PROCEDURE AllocNamedObjectA* [base,-228]
( name [8] : ARRAY OF CHAR; tagList [9] : ARRAY OF TagItem )
: NamedObjectPtr;
PROCEDURE AllocNamedObject* [base,-228]
( name [8] : ARRAY OF CHAR; tagList [9].. : Tag )
: NamedObjectPtr;
PROCEDURE AttemptRemNamedObject* [base,-234]
( object [8] : NamedObjectPtr )
: BOOLEAN;
PROCEDURE FindNamedObject* [base,-240]
( nameSpace [8] : NamedObjectPtr; name [9] : ARRAY OF CHAR;
lastObject [10] : NamedObjectPtr )
: NamedObjectPtr;
PROCEDURE FreeNamedObject* [base,-246]
( object [8] : NamedObjectPtr );
PROCEDURE NamedObjectName* [base,-252]
( object [8] : NamedObjectPtr )
: e.LSTRPTR;
PROCEDURE ReleaseNamedObject* [base,-258]
( object [8] : NamedObjectPtr );
PROCEDURE RemNamedObject* [base,-264]
( object [8] : NamedObjectPtr; message [9] : e.MessagePtr );
(* Unique ID generator *)
PROCEDURE GetUniqueID* [base,-270] ()
: e.ULONG;
(*------------------------------------*)
(*
This procedure is intended to be installed in the entry field of a
u.Hook record. Its purpose is to push the parameters passed to it
onto the stack and call the procedure installed in the subEntry field.
The parameters are:
hook : u.HookPtr; (* passed in the A0 register *)
object : e.APTR; (* passed in the A2 register *)
message : e.APTR; (* passed in the A1 register *)
Stack checking should be turned off (StackChk-) in all procedures
installed in Hooks, as they are likely to be running in a non-Oberon
context.
*)
PROCEDURE [0] HookEntry* () : e.APTR;
<*$EntryExitCode-*>
BEGIN (* HookEntry *)
SYS.INLINE (
48E7H, 3F3EH, (* MOVEM.L D2-D7,A2-A6,-(A7) *)
<*IF SMALLDATA OR RESIDENT THEN*> (* Set up the data segment pointer *)
2868H, 0010H, (* MOVE.L $0010(A0), A4 *)
<*END*>
2F08H, (* MOVE.L A0, -(A7) *)
2F0AH, (* MOVE.L A2, -(A7) *)
2F09H, (* MOVE.L A1, -(A7) *)
2068H, 000CH, (* MOVE.L $000C(A0), A0 *)
4E90H, (* JSR (A0) *)
4CDFH, 7CFCH, (* MOVEM.L (A7)+,D2-D7,A2-A6 *)
4E75H ) (* RTS *)
(*
No RETURN is required, result is already in D0.
The procedure in subEntry will clean up the parameters on the stack.
*)
END HookEntry;
(*------------------------------------*)
PROCEDURE [0] InitHook * (hook : HookBasePtr; subEntry : HookFunc);
VAR h : HookPtr;
BEGIN (* InitHook *)
h := SYS.VAL (HookPtr, hook);
h.entry := HookEntry;
h.subEntry := subEntry;
<*IF SMALLDATA OR RESIDENT THEN*>
SYS.GETREG (12, h.data)
<*ELSE*>
h.data := NIL
<*END*>
END InitHook;
(*---- useful procedures ---- *)
PROCEDURE [0] IgnoreIfNIL * (tagVal: TagID; data: Tag): TagID;
BEGIN
IF SYS.VAL(e.APTR,data) # NIL THEN RETURN tagVal ELSE RETURN ignore END;
END IgnoreIfNIL;
PROCEDURE [0] Bool2Long * (b: BOOLEAN): e.LONGBOOL;
BEGIN
IF b THEN RETURN e.LTRUE ELSE RETURN e.LFALSE; END;
END Bool2Long;
PROCEDURE [0] Long2Bool * (value: LONGINT): BOOLEAN;
BEGIN
RETURN value # e.LFALSE;
END Long2Bool;
(*-- Library Base variable --------------------------------------------*)
<*$LongVars-*>
(*-----------------------------------*)
PROCEDURE* [0] CloseLib (VAR rc : LONGINT);
BEGIN (* CloseLib *)
IF base # NIL THEN e.CloseLibrary (base) END;
END CloseLib;
BEGIN
base := SYS.VAL (UtilityBasePtr,
e.OpenLibrary (utilityName, e.libraryMinimum));
IF base = NIL THEN HALT (100) END;
Kernel.SetCleanup (CloseLib)
END Utility.